home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BUTTONS / BUTTONS / BUTTONS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-13  |  14KB  |  368 lines
  1. Unit Buttons;
  2. {***************************************************************************}
  3. {*  Buttons.pas  by Daniel Thomas (CIS: 72301,2164)                        *}
  4. {*                                                                         *}
  5. {*    This code is hereby donated to tbe Public Domain.  Have fun!         *}
  6. {*                                                                         *}
  7. {*                                                                         *}
  8. {* There are 2 kinds of Button objects in this library.  Both of them      *}
  9. {* are for creating buttons made up of bitmaps.  The first object uses     *}
  10. {* only one bitmap, and draws any needed "effects".  The second object     *}
  11. {* uses three bitmaps, one for each state (up, down, and disabled).        *}
  12. {*                                                                         *}
  13. {* Neither of these objects supports drawing on Dialogs, but it's a        *}
  14. {* start!  Also, neither of these buttons looks any different if it's      *}
  15. {* the default button.  Again, you're on your own!                         *}
  16. {*                                                                         *}
  17. {* For either type of button, just Init the object in the parent's Init    *}
  18. {* method, and you've got a button!  If you want to create it in some      *}
  19. {* other method than the parent's Init method, use Application^.MakeWindow *}
  20. {* to make it visible.                                                     *}
  21. {*                                                                         *}
  22. {* Add a method to the parent window, like this:                           *}
  23. {*                                                                         *}
  24. {*    Procedure wmDrawItem(var Msg:tMessage);virtual wm_First+wm_DrawItem; *}
  25. {*                                                                         *}
  26. {* It should look like this:                                               *}
  27. {*                                                                         *}
  28. {*    Procedure tMainWindow.wmDrawItem(var Msg:tMessage);                  *}
  29. {*    begin                                                                *}
  30. {*      with pDrawItemStruct(Msg.lParam)^ do                               *}
  31. {*        case CtlType of                                                  *}
  32. {*            odt_Button:                                                  *}
  33. {*              case CtlID of                                              *}
  34. {*                  id_Button1 : Button1^.DrawItem(Msg);                   *}
  35. {*                  id_Button2 : Button2^.DrawItem(Msg);                   *}
  36. {*              end;                                                       *}
  37. {*        end;                                                             *}
  38. {*    end;                                                                 *}
  39. {*                                                                         *}
  40. {*                                                                         *}
  41. {* tSingleBitmapButton                                                     *}
  42. {*                                                                         *}
  43. {*   Two Init methods.  The second one allows you to specify the color     *}
  44. {*   of a surrounding box.                                                 *}
  45. {*                                                                         *}
  46. {*   Specify the parent object (@self), an ID number, the location of      *}
  47. {*   the button (x & y), whether it's the default, and the name of the     *}
  48. {*   bitmap.  (The second Init method also let's you specify an RGB        *}
  49. {*   color for a border).                                                  *}
  50. {*                                                                         *}
  51. {*   Create the bitmap as large as the button needs to be, minus the       *}
  52. {*   surrounding black box.  It is assumed that the button's "background"  *}
  53. {*   color is light gray.  The "shading" effects will be drawn for you.    *}
  54. {*                                                                         *}
  55. {* tMultiBitmapButton                                                      *}
  56. {*                                                                         *}
  57. {*   Specify the parent object (@self), an ID number, the location of      *}
  58. {*   the button (x & y), whether it's the default, and the name of the     *}
  59. {*   three bitmaps (one for a non-pressed button, one for a pressed        *}
  60. {*   button, and one for a disabled button).  ALL THREE MUST BE THE SAME   *}
  61. {*   SIZE.                                                                 *}
  62. {*                                                                         *}
  63. {***************************************************************************}
  64.  
  65. interface
  66.  
  67. uses WinTypes,WinProcs,WObjects;
  68.  
  69. type
  70.   pSingleBitmapButton=^tSingleBitmapButton;
  71.   tSingleBitmapButton=object(tButton)
  72.       Bitmap             : hBitmap;
  73.       UseSpecialBorder   : boolean;
  74.       SpecialBorderColor : longint;
  75.  
  76.       constructor Init(aParent: pWindowsObject; aID: Integer;
  77.                        X,Y: Integer; IsDefault: Boolean;
  78.                        aBitmap: pChar);
  79.       constructor InitWithSpecialBorder(
  80.                        aParent: pWindowsObject; aID: Integer;
  81.                        X,Y: Integer; IsDefault: Boolean;
  82.                        aBitmap: pChar;
  83.                        aSpecialBorderColor: longint);
  84.       destructor Done; virtual;
  85.       procedure DrawItem(var Msg:tMessage); virtual;
  86.     end;
  87.  
  88.   pMultiBitmapButton=^tMultiBitmapButton;
  89.   tMultiBitmapButton=object(tButton)
  90.       NormalBitmap,
  91.       DownBitmap,
  92.       DisabledBitmap : hBitmap;
  93.  
  94.       constructor Init(aParent: pWindowsObject; aID: Integer;
  95.                        X,Y: Integer; IsDefault: Boolean;
  96.                        aNormalBitmap,aDownBitmap,aDisabledBitmap: pChar);
  97.       destructor Done; virtual;
  98.       procedure DrawItem(var Msg:tMessage); virtual;
  99.     end;
  100.  
  101. implementation
  102.  
  103. const
  104.   cBlackColor     = $00000000;
  105.   cWhiteColor     = $00FFFFFF;
  106.   cDarkGrayColor  = $00808080;
  107.   cLightGrayColor = $00C0C0C0;
  108.  
  109. type
  110.   pDrawItemStruct = ^tDrawItemStruct;
  111.  
  112. var
  113.   bmp : hBitmap;
  114.  
  115. {**************************************************************************}
  116. {*  tSingleBitmapButton                                                   *}
  117. {**************************************************************************}
  118.  
  119. constructor tSingleBitmapButton.Init(aParent: pWindowsObject; aID: Integer;
  120.                                      X,Y: Integer; IsDefault: Boolean;
  121.                                      aBitmap: pChar);
  122.  
  123. var
  124.   bm  : tBitMap;
  125.   w,h : integer;
  126.  
  127. begin
  128.   bmp := LoadBitmap(hInstance,aBitmap);
  129.   GetObject(bmp,sizeof(bm),@bm);
  130.   tButton.Init(aParent,aID,'Dummy',x,y,bm.bmWidth+2,bm.bmHeight+2,IsDefault);
  131.   Attr.Style := Attr.Style or bs_OwnerDraw;
  132.   Bitmap := bmp;
  133.   UseSpecialBorder := false;
  134. end; {tSingleBitmapButton.Init}
  135.  
  136. constructor tSingleBitmapButton.InitWithSpecialBorder(
  137.                                      aParent: pWindowsObject; aID: Integer;
  138.                                      X,Y: Integer; IsDefault: Boolean;
  139.                                      aBitmap: pChar;
  140.                                      aSpecialBorderColor: longint);
  141.  
  142. var
  143.   bm  : tBitMap;
  144.   w,h : integer;
  145.  
  146. begin
  147.   bmp := LoadBitmap(hInstance,aBitmap);
  148.   GetObject(bmp,sizeof(bm),@bm);
  149.   tButton.Init(aParent,aID,'Dummy',x,y,bm.bmWidth+4,bm.bmHeight+4,IsDefault);
  150.   Attr.Style := Attr.Style or bs_OwnerDraw;
  151.   Bitmap := bmp;
  152.   UseSpecialBorder := true;
  153.   SpecialBorderColor := aSpecialBorderColor;
  154. end; {tSingleBitmapButton.Init}
  155.  
  156. destructor tSingleBitmapButton.Done;
  157.  
  158. begin
  159.   tButton.Done;
  160.   DeleteObject(Bitmap);
  161. end; {tSingleBitmapButton.Done}
  162.  
  163. procedure tSingleBitmapButton.DrawItem(var Msg: tMessage);
  164.  
  165. var
  166.   Down            : boolean;
  167.   OldMode,
  168.   w,h,x1,y1       : integer;
  169.   MemDC           : hDC;
  170.   OldBmp          : hBitmap;
  171.   Pts             : array[0..4] of tPoint;
  172.   Pen,
  173.   OldPen          : hPen;
  174.   Brush,
  175.   OldBrush        : hBrush;
  176.   TopLeftLine1,
  177.   TopLeftLine2,
  178.   BottomRightLine1,
  179.   BottomRightLine2: array[0..2] of TPoint;
  180.  
  181. begin
  182.   with pDrawItemStruct(Msg.lParam)^, rcItem do begin
  183.     if ItemAction = oda_Focus then
  184.       exit;
  185.  
  186.     Down := ((ItemAction and oda_Select) > 0)
  187.             and ((ItemState and ods_Selected) > 0);
  188.     if UseSpecialBorder then
  189.       begin
  190.         x1 := 1;
  191.         y1 := 1;
  192.       end
  193.     else
  194.       begin
  195.         x1 := 0;
  196.         y1 := 0;
  197.       end;
  198.     w := right - left - (2*x1);
  199.     h := bottom - top - (2*y1);
  200.  
  201.  
  202. {Draw the bitmap - offset to the left and down if the button is down}
  203.     MemDC := CreateCompatibleDC(hDC);
  204.     SelectObject(MemDC,Bitmap);
  205.     if Down then
  206.       BitBlt(hDC,left+3+x1,top+3+y1,w-4,h-4,MemDC,0,0,SrcCopy)
  207.     else
  208.       BitBlt(hDC,left+1+x1,top+1+y1,w-2,h-2,MemDC,0,0,SrcCopy);
  209.     DeleteDC(MemDC);
  210.  
  211. {"Gray" the button, if it is disabled}
  212.     if (itemState and ods_Disabled <> 0)
  213.         or (itemState and ods_Grayed <> 0) then
  214.       begin
  215.         Pen := CreatePen(ps_Solid,1,cBlackColor);
  216.         OldPen := SelectObject(hDC,Pen);
  217.         Brush := CreateHatchBrush(hs_bDiagonal,cBlackColor);
  218.         OldBrush := SelectObject(hDC,Brush);
  219.         OldMode := SetBkMode(hDC,Transparent);
  220.         Rectangle(Hdc,left+x1,top+y1,right-x1,bottom-y1);
  221.         SelectObject(hDC,OldPen);
  222.         DeleteObject(Pen);
  223.         SelectObject(hDC,OldBrush);
  224.         DeleteObject(Brush);
  225.         SetBkMode(hDC,OldMode);
  226.       end;
  227.  
  228. {Draw the surrounding rectangle}
  229.     Pen := CreatePen(ps_Solid,1,cBlackColor);
  230.     OldPen := SelectObject(hDC,Pen);
  231.     Brush := GetStockObject(Null_Brush);
  232.     OldBrush := SelectObject(hDC,Brush);
  233.     Rectangle(Hdc,left+x1,top+y1,right-x1,bottom-y1);
  234.     SelectObject(hDC,OldPen);
  235.     DeleteObject(Pen);
  236.     if UseSpecialBorder then
  237.       begin
  238.         Pen := CreatePen(ps_Solid,1,SpecialBorderColor);
  239.         OldPen := SelectObject(hDC,Pen);
  240.         Rectangle(Hdc,left,top,right,bottom);
  241.         SelectObject(hDC,OldPen);
  242.         DeleteObject(Pen);
  243.       end;
  244.     SelectObject(hDC,OldBrush);
  245.  
  246. {Draw the "shading"}
  247.     TopLeftLine1[0].x := right-(2+x1);
  248.     TopLeftLine1[0].y := top+1+y1;
  249.     TopLeftLine1[1].x := left+1+x1;
  250.     TopLeftLine1[1].y := top+1+y1;
  251.     TopLeftLine1[2].x := left+1+x1;
  252.     TopLeftLine1[2].y := bottom-(1+y1);
  253.     TopLeftLine2[0].x := right-(3+x1);
  254.     TopLeftLine2[0].y := top+2+y1;
  255.     TopLeftLine2[1].x := left+2+x1;
  256.     TopLeftLine2[1].y := top+2+y1;
  257.     TopLeftLine2[2].x := left+2+x1;
  258.     TopLeftLine2[2].y := bottom-(2+y1);
  259.     if not down then
  260.       begin
  261.         BottomRightLine1[0].x := right-(2+x1);
  262.         BottomRightLine1[0].y := top+2+y1;
  263.         BottomRightLine1[1].x := right-(2+x1);
  264.         BottomRightLine1[1].y := bottom-(2+y1);
  265.         BottomRightLine1[2].x := left+1+x1;
  266.         BottomRightLine1[2].y := bottom-(2+y1);
  267.         BottomRightLine2[0].x := right-(3+x1);
  268.         BottomRightLine2[0].y := top+3+y1;
  269.         BottomRightLine2[1].x := right-(3+x1);
  270.         BottomRightLine2[1].y := bottom-(3+y1);
  271.         BottomRightLine2[2].x := left+2+x1;
  272.         BottomRightLine2[2].y := bottom-(3+y1);
  273.       end;
  274.  
  275.     if Down then
  276.       begin
  277.         Pen := CreatePen(ps_Solid,1,cDarkGrayColor);
  278.         OldPen := SelectObject(hDC,Pen);
  279.         PolyLine(hDC,TopLeftLine1,3);
  280.         PolyLine(hDC,TopLeftLine2,3);
  281.         SetPixel(hDC,right-(2+x1),top+2+y1,cLightGrayColor);
  282.         SetPixel(hDC,left+2+x1,bottom-(2+y1),cLightGrayColor);
  283.         SelectObject(hDC,OldPen);
  284.         DeleteObject(Pen);
  285.       end
  286.     else
  287.       begin
  288.         Pen := CreatePen(ps_Solid,1,cWhiteColor);
  289.         OldPen := SelectObject(hDC,Pen);
  290.         PolyLine(hDC,TopLeftLine1,3);
  291.         if w > 24 then
  292.           PolyLine(hDC,TopLeftLine2,3);
  293.         SelectObject(hDC,OldPen);
  294.         DeleteObject(Pen);
  295.         Pen := CreatePen(ps_Solid,1,cDarkGrayColor);
  296.         OldPen := SelectObject(hDC,Pen);
  297.         PolyLine(hDC,BottomRightLine1,3);
  298.         PolyLine(hDC,BottomRightLine2,3);
  299.         SelectObject(hDC,OldPen);
  300.         DeleteObject(Pen);
  301.       end;
  302.   end; {of with}
  303. end; {tSingleBitmapButton.DrawItem}
  304.  
  305. {**************************************************************************}
  306. {*  tMultiBitmapButton                                                    *}
  307. {**************************************************************************}
  308.  
  309. constructor tMultiBitmapButton.Init(aParent: pWindowsObject; aID: Integer;
  310.                                     X,Y: Integer; IsDefault: Boolean;
  311.                                     aNormalBitmap,aDownBitmap,aDisabledBitmap: pChar);
  312.  
  313. var
  314.   bm  : tBitMap;
  315.   w,h : integer;
  316.  
  317. begin
  318.   bmp := LoadBitmap(hInstance,aNormalBitmap);
  319.   GetObject(bmp,sizeof(bm),@bm);
  320.   tButton.Init(aParent,aID,'Dummy',x,y,bm.bmWidth,bm.bmHeight,IsDefault);
  321.   Attr.Style := Attr.Style or bs_OwnerDraw;
  322.   NormalBitmap := bmp;
  323.   DownBitmap := LoadBitmap(hInstance,aDownBitmap);
  324.   DisabledBitmap := LoadBitmap(hInstance,aDisabledBitmap);
  325. end; {tMultiBitmapButton.Init}
  326.  
  327. destructor tMultiBitmapButton.Done;
  328.  
  329. begin
  330.   tButton.Done;
  331.   DeleteObject(NormalBitmap);
  332.   DeleteObject(DownBitmap);
  333.   DeleteObject(DisabledBitmap);
  334. end; {tMultiBitmapButton.Done}
  335.  
  336. procedure tMultiBitmapButton.DrawItem(var Msg: tMessage);
  337.  
  338. var
  339.   Down,
  340.   Disabled : boolean;
  341.   MemDC    : hDC;
  342.  
  343. begin
  344.   with pDrawItemStruct(Msg.lParam)^, rcItem do begin
  345.     if ItemAction = oda_Focus then
  346.       exit;
  347.  
  348.     Down := ((ItemAction and oda_Select) > 0)
  349.             and ((ItemState and ods_Selected) > 0);
  350.     Disabled := (itemState and ods_Disabled <> 0)
  351.                 or (itemState and ods_Grayed <> 0);
  352.  
  353.     MemDC := CreateCompatibleDC(hDC);
  354.     if Down then
  355.       SelectObject(MemDC,DownBitmap)
  356.     else
  357.     if Disabled then
  358.       SelectObject(MemDC,DisabledBitmap)
  359.     else
  360.       SelectObject(MemDC,NormalBitmap);
  361.     BitBlt(hDC,left,top,right-left,bottom-top,MemDC,0,0,SrcCopy);
  362.     DeleteDC(MemDC);
  363.   end; {of with}
  364. end; {tMultiBitmapButton.DrawItem}
  365.  
  366.  
  367. end.
  368.